home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
Tech Arsenal 1
/
Tech Arsenal (Arsenal Computer).ISO
/
tek-02
/
hotm60.zip
/
HOTMOD.PAS
< prev
Wrap
Pascal/Delphi Source File
|
1991-03-19
|
14KB
|
540 lines
program HotMod;
{ Turbo Pascal Hot Key Modification Program. Version 6.0 03/18/91 }
{ Copyright (c) 1991 Ron Schuster. For non-commercial use only. }
{ The cursor routines were extracted from CURSORS.PAS by Scott Bussinger. The
complete set can be downloaded from CompuServe. (BPROGA Lib 6 CURSOR.ARC) }
uses Crt, Dos;
const
MaxOffsets = 8;
type
KeyStr = string[15];
CursorSize = word;
HotkeyRec = record
Name : string[25];
Offsets : array [1..MaxOffsets] of LongInt;
end;
const
StartAddr = $44F00;
EndAddr = $45a00;
NbrOfHotkeys = 26;
NbrOfRows = succ (NbrOfHotkeys) div 2;
Hotkeys : array [1..NbrOfHotkeys] of HotkeyRec = (
(Name: 'Compile|Compile'; Offsets:($4524A,$4576F,$4598E,0,0,0,0,0)),
(Name: 'Compile|Make'; Offsets:($45260,$45784,$4587F,$459A3,0,0,0,0)),
(Name: 'Debug|Add Watch'; Offsets:($4530B,0,0,0,0,0,0,0)),
(Name: 'Debug|Evaluate/Modify'; Offsets:($452DA,0,0,0,0,0,0,0)),
(Name: 'Debug|Toggle Breakpoint'; Offsets:($4537F,0,0,0,0,0,0,0)),
(Name: 'File|Exit'; Offsets:($45000,0,0,0,0,0,0,0)),
(Name: 'File|Open'; Offsets:($44F44,$45761,$45980,0,0,0,0,0)),
(Name: 'File|Save'; Offsets:($44F65,$45753,$45972,0,0,0,0,0)),
(Name: 'Help'; Offsets:($45745,$457A7,$4581F,$45854,$458A2,$4590E,$45964,$459C6)),
(Name: 'Help|Index'; Offsets:($45675,$458D4,0,0,0,0,0,0)),
(Name: 'Help|Previous Topic'; Offsets:($456B6,$458B8,0,0,0,0,0,0)),
(Name: 'Help|Topic Search'; Offsets:($45695,0,0,0,0,0,0,0)),
(Name: 'Menu'; Offsets:($45792,$45800,$4583F,$4588D,$4594F,$459B1,0,0)),
(Name: 'Run|Go to Cursor'; Offsets:($451DA,0,0,0,0,0,0,0)),
(Name: 'Run|Program Reset'; Offsets:($451BB,0,0,0,0,0,0,0)),
(Name: 'Run|Run'; Offsets:($4519B,0,0,0,0,0,0,0)),
(Name: 'Run|Step Over'; Offsets:($45209,$457C4,$45871,$45941,0,0,0,0)),
(Name: 'Run|Trace Into'; Offsets:($451F2,$457B5,$45862,$45932,0,0,0,0)),
(Name: 'Window|Call stack'; Offsets:($455FB,0,0,0,0,0,0,0)),
(Name: 'Window|Close'; Offsets:($4559F,0,0,0,0,0,0,0)),
(Name: 'Window|List'; Offsets:($4563B,0,0,0,0,0,0,0)),
(Name: 'Window|Next'; Offsets:($45570,0,0,0,0,0,0,0)),
(Name: 'Window|Previous'; Offsets:($45586,0,0,0,0,0,0,0)),
(Name: 'Window|Size/Move'; Offsets:($45524,0,0,0,0,0,0,0)),
(Name: 'Window|User Screen'; Offsets:($45619,0,0,0,0,0,0,0)),
(Name: 'Window|Zoom'; Offsets:($4553B,0,0,0,0,0,0,0)));
MinKey = 14;
MaxKey = 165;
KeyNames : array [MinKey..MaxKey] of KeyStr = (
'Alt-Backspace', {14}
'Shift-Tab', {15}
'Alt-Q', {16}
'Alt-W', {17}
'Alt-E', {18}
'Alt-R', {19}
'Alt-T', {20}
'Alt-Y', {21}
'Alt-U', {22}
'Alt-I', {23}
'Alt-O', {24}
'Alt-P', {25}
'Alt-[', {26}
'Alt-]', {27}
'Alt-Enter', {28}
'Ctrl', {29}
'Alt-A', {30}
'Alt-S', {31}
'Alt-D', {32}
'Alt-F', {33}
'Alt-G', {34}
'Alt-H', {35}
'Alt-J', {36}
'Alt-K', {37}
'Alt-L', {38}
'Alt-;', {39}
'Alt-''', {40}
'Alt-`', {41}
'LeftShift', {42}
'Alt-\', {43}
'Alt-Z', {44}
'Alt-X', {45}
'Alt-C', {46}
'Alt-V', {47}
'Alt-B', {48}
'Alt-N', {49}
'Alt-M', {50}
'Alt-,', {51}
'Alt-.', {52}
'Alt-/', {53}
'RightShift', {54}
'PrtSc', {55}
'Alt', {56}
'Space', {57}
'CapLock', {58}
'F1', {59}
'F2', {60}
'F3', {61}
'F4', {62}
'F5', {63}
'F6', {64}
'F7', {65}
'F8', {66}
'F9', {67}
'F10', {68}
'NumLock', {69}
'ScrollLock', {70}
'Home', {71}
'UpArrow', {72}
'PgUp', {73}
'Minus', {74}
'LeftArrow', {75}
'Center', {76}
'RightArrow', {77}
'Plus', {78}
'End', {79}
'DownArrow', {80}
'PgDn', {81}
'Ins', {82}
'Del', {83}
'Shift-F1', {84}
'Shift-F2', {85}
'Shift-F3', {86}
'Shift-F4', {87}
'Shift-F5', {88}
'Shift-F6', {89}
'Shift-F7', {90}
'Shift-F8', {91}
'Shift-F9', {92}
'Shift-F10', {93}
'Ctrl-F1', {94}
'Ctrl-F2', {95}
'Ctrl-F3', {96}
'Ctrl-F4', {97}
'Ctrl-F5', {98}
'Ctrl-F6', {99}
'Ctrl-F7', {100}
'Ctrl-F8', {101}
'Ctrl-F9', {102}
'Ctrl-F10', {103}
'Alt-F1', {104}
'Alt-F2', {105}
'Alt-F3', {106}
'Alt-F4', {107}
'Alt-F5', {108}
'Alt-F6', {109}
'Alt-F7', {110}
'Alt-F8', {111}
'Alt-F9', {112}
'Alt-F10', {113}
'Ctrl-PrtSc', {114}
'Ctrl-LeftArrow', {115}
'Ctrl-RightArrow', {116}
'Ctrl-End', {117}
'Ctrl-PgDn', {118}
'Ctrl-Home', {119}
'Alt-1', {120}
'Alt-2', {121}
'Alt-3', {122}
'Alt-4', {123}
'Alt-5', {124}
'Alt-6', {125}
'Alt-7', {126}
'Alt-8', {127}
'Alt-9', {128}
'Alt-0', {129}
'Alt--', {130}
'Alt-=', {131}
'Ctrl-PgUp', {132}
'F11', {133}
'F12', {134}
'Shift-F11', {135}
'Shift-F12', {136}
'Ctrl-F11', {137}
'Ctrl-F12', {138}
'Alt-F11', {139}
'Alt-F12', {140}
'Ctrl-UpArrow', {141}
'Ctrl-Minus', {142}
'Ctrl-Center', {143}
'Ctrl-Plus', {144}
'Ctrl-DownArrow', {145}
'Ctrl-Ins', {146}
'Ctrl-Del', {147}
'Ctrl-Tab', {148}
'?', {149}
'?', {150}
'Alt-Home', {151}
'Alt-UpArrow', {152}
'Alt-PgUp', {153}
'?', {154}
'Alt-LeftArrow', {155}
'Alt-Center', {156}
'Alt-RightArrow', {157}
'?', {158}
'Alt-End', {159}
'Alt-DownArrow', {160}
'Alt-PgDn', {161}
'Alt-Ins', {162}
'Alt-Del', {163}
'?', {164}
'Alt-Tab'); {165}
var
Turbo : file;
OriginalCursor: CursorSize;
Buf : array [0..EndAddr-StartAddr] of Byte;
Save : Boolean;
function MonoDisplay: boolean;
{ Return true if the current display is a monochrome adapter }
var Reg: Registers;
begin
Reg.AH := $0F;
Intr ($10, Reg);
MonoDisplay := Reg.AL = 7
end;
procedure GetCursor (var Curs: CursorSize);
{ Get the current cursor size }
var Reg: Registers;
begin
Reg.AH := $03;
Reg.BH := $00;
Intr ($10, Reg);
if (Reg.CX=$0607) and MonoDisplay
then
Curs := $0C0D { Watch out for bug in DOS }
else
Curs := Reg.CX
end;
procedure SetCursor (Curs: CursorSize);
{ Set the current cursor size }
var Reg: Registers;
begin
Reg.AH := $01;
Reg.CX := Curs;
Intr ($10, Reg)
end;
function KeyName (Key : Byte) : KeyStr;
{ Return the name of the key, given its key code }
begin
if Key = 0 then
KeyName := '<Disabled>'
else if (Key >= MinKey) and (Key <= MaxKey) then
KeyName := KeyNames[Key]
else
KeyName := '?';
end;
function Pad (S : String; Len : Integer) : String;
begin
while Length (S) < Len do
S := S + ' ';
Pad := S;
end;
function LeftPad (S : String; Len : Integer) : String;
begin
while Length (S) < Len do
S := ' ' + S;
LeftPad := S;
end;
function CharStr (Ch : Char; Len : Byte) : string;
var
S : string;
begin
Byte(S[0]) := Len;
FillChar (S[1], Len, Ch);
CharStr := S;
end;
procedure NormalVideo;
begin
if MonoDisplay then begin
TextColor (White);
TextBackground (Black);
end
else begin
TextColor (LightGray);
TextBackground (Blue);
end;
end;
procedure ReverseVideo;
begin
if MonoDisplay then begin
TextColor (Black);
TextBackground (LightGray);
end
else begin
TextColor (White);
TextBackground (Black);
end;
end;
function GetKeyOffset (L : LongInt) : LongInt;
{ Given the offset of the text string, return the offset of the key code }
begin
if Buf[L-StartAddr+1] = ord('~') then
GetKeyOffset := L + Buf[L-StartAddr] + 2
else
GetKeyOffset := L - 3;
end;
function GetKeyCode (L : LongInt) : Byte;
{ Given the offset of the text string, return the associated key code }
begin
GetKeyCode := Buf[GetKeyOffset(L)-StartAddr];
end;
procedure PutKeyCode (L : LongInt; K : Byte);
{ Given the offset of the text string, update the associated key code }
begin
Buf[GetKeyOffset(L)-StartAddr] := K;
end;
procedure DisplayHotkey (I : Integer);
{ Display the name and current key assignment of the hot key }
begin
with Hotkeys[I] do begin
GotoXY (40 * (pred (I) div NbrOfRows) + 1, pred (I) mod NbrOfRows + 10);
Write (Pad (Name, 25), Pad (Keyname (GetKeyCode(Offsets[1])), 15));
end;
end;
procedure DisplayMenu;
var
I : Integer;
begin
TextColor (Black);
TextBackground (LightGray);
ClrScr;
Writeln ('HOTMOD - The Turbo Pascal Hot Key Modifier. Version 6.0.');
Writeln ('Copyright (c) 1991 Ron Schuster. For non-commercial use only.');
Writeln;
Writeln ('Move the cursor to the hot key that you want to change.');
Writeln ('Press the key that you want to change it to.');
Writeln ('To disable a hot key, press Ctrl-@. The disabled key can then be');
Writeln ('reassigned to an editor function or macro with Borland''s TEMC program.');
Writeln ('Press Esc to save your changes and exit.');
NormalVideo;
for I := 1 to NbrOfHotkeys do
DisplayHotkey (I);
end;
function Read_Key : Word;
var
Key : Char;
begin
Key := ReadKey;
if Key = #0 then begin
Key := ReadKey;
if Key = #3 then
Read_Key := 0 {Ctrl-@}
else
Read_Key := word (ord (Key)) shl 8;
end
else
Read_Key := ord (Key);
end;
function MakeChanges : boolean;
const
Esc = 27;
UpArrow = 72;
DownArrow = 80;
LeftArrow = 75;
RightArrow = 77;
var
Sel : Integer;
I : Integer;
Key : Word;
Done : Boolean;
HiKey : Byte;
ChangeMade : Boolean;
procedure ChangeSelection (New : Integer);
begin
NormalVideo;
DisplayHotkey (Sel);
Sel := New;
ReverseVideo;
DisplayHotkey (Sel);
end;
procedure ChangeKeys;
var
I : Integer;
begin
with Hotkeys[Sel] do
for I := 1 to MaxOffsets do
if Offsets[I] <> 0 then
PutKeyCode (Offsets[I], Hi(Key));
end;
procedure ChangeHelps;
var
NewKeyName : KeyStr;
MaxHelpLen : Integer;
I : Integer;
begin
with Hotkeys[Sel] do begin
NewKeyName := KeyName(Hi(Key));
if Buf[Offsets[1]-StartAddr+1] <> ord('~') then
MaxHelpLen := Buf[Offsets[1]-StartAddr]
else begin
MaxHelpLen := 1;
while Buf[Offsets[1]-StartAddr+2+MaxHelpLen] <> ord('~') do
Inc(MaxHelpLen);
end;
if (NewKeyName[1] = '<') or (Length(NewKeyName) > MaxHelpLen) then
NewKeyName := CharStr ('*', MaxHelpLen)
else
NewKeyName := LeftPad(NewKeyName, MaxHelpLen);
for I := 1 to MaxOffsets do
if Offsets[I] <> 0 then
if Buf[Offsets[I]-StartAddr+1] <> ord('~') then
Move (NewKeyName[1],Buf[Offsets[I]-StartAddr+1],MaxHelpLen)
else
Move (NewKeyName[1],Buf[Offsets[I]-StartAddr+2],MaxHelpLen);
end;
end;
begin {MakeChanges}
ChangeMade := False;
Sel := 1;
ReverseVideo;
DisplayHotkey (1);
Done := False;
repeat
Key := Read_Key;
case Lo (Key) of
0: case Hi (Key) of
UpArrow: if Sel > 1 then
ChangeSelection (pred (Sel));
DownArrow: if Sel < NbrOfHotkeys then
ChangeSelection (succ (Sel));
LeftArrow: if Sel > NbrOfRows then
ChangeSelection (Sel - NbrOfRows);
RightArrow: if Sel <= NbrOfRows then
ChangeSelection (Sel + NbrOfRows);
else begin
if GetKeyCode(Hotkeys[Sel].Offsets[1]) <> Hi(Key) then begin
ChangeKeys;
ChangeHelps;
DisplayHotkey (Sel);
ChangeMade := True;
end;
end;
end; {case Hi (Key)}
Esc : Done := True;
else Write (^G);
end; {case Lo (Key)}
until Done;
ClrScr;
if ChangeMade then begin
Write ('Save changes to TURBO.EXE (Y/N) ?');
repeat
Key := Read_Key
until Upcase(Chr(Lo(Key))) in ['Y','N'];
MakeChanges := Upcase(Chr(Lo(Key))) = 'Y';
end
else
MakeChanges := False;
end; {MakeChanges}
procedure OpenTurbo;
var
IO_result : Word;
Result : Word;
begin
{$I-}
Assign (Turbo, 'TURBO.EXE');
Reset (Turbo,1);
IO_result := IOresult;
if IO_result <> 0 then begin
Writeln ('Could not open TURBO.EXE');
Writeln ('IOresult = ', IO_result);
Halt (1);
end;
if FileSize (Turbo) <> 325397 then begin
Writeln ('Incorrect version of Turbo Pascal. This program only supports 6.0.');
Halt (2);
end;
Seek (Turbo, StartAddr);
BlockRead (Turbo, Buf, sizeof(Buf), Result);
IO_result := IOresult;
if (IO_result <> 0) or (Result <> sizeof(Buf)) then begin
Writeln ('Error reading TURBO.EXE');
Writeln ('IOresult = ', IO_result);
Halt (1);
end;
{$I+}
end;
procedure CloseTurbo(Save : Boolean);
var
IO_result : Word;
Result : Word;
begin
{$I-}
if Save then begin
Seek (Turbo, StartAddr);
BlockWrite (Turbo, Buf, sizeof(Buf), Result);
IO_result := IOresult;
if (IO_result <> 0) or (Result <> sizeof(Buf)) then begin
Writeln ('Error writing changes to TURBO.EXE');
Writeln ('IOresult = ', IO_result);
Halt (1);
end;
end;
Close (Turbo);
{$I+}
end;
begin { main program }
OpenTurbo;
GetCursor (OriginalCursor);
SetCursor ($2000); { Make the cursor invisible }
DisplayMenu;
Save := MakeChanges;
SetCursor (OriginalCursor);
NormVideo;
ClrScr;
CloseTurbo(Save);
end.